home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / AlphaLite.6.52 / Tcl / SystemCode / getVarValue.tcl < prev    next >
Text File  |  1996-08-15  |  6KB  |  195 lines
  1. #############################################################################
  2. #  Report the current value of a global variable, chosen interactively
  3. #  from a list of all active variables.
  4. #
  5. #  If the variable is an array, or its value is too big to fit in an 
  6. #  alertnote, then its contents are listed in a new window, otherwise 
  7. #  the variable's value is displayed in an alertnote.
  8. #
  9. proc getVarValue {} {
  10.     set def [getText [getPos] [selEnd]]
  11.     set var [listpick -p {Which var?} -L $def [lsort -ignore [info globals]]]
  12.     if {![string length $var]} return
  13.     showVarValue $var
  14. }
  15.  
  16. proc showVarValue {var} {
  17.     global $var
  18.     if {![catch {set $var} value]} {
  19.         if {![catch {alertnote "'$var' = $value"}]} {
  20.             return
  21.         } else {
  22.             new -n "* $var *"
  23.             insertText "'$var' = $value"
  24.         }
  25.     } else {
  26.         new -n "* $var *"
  27.         listArray $var
  28.     }
  29.     goto 0
  30. # if 'shrinkWindow' is loaded, call it to trim the output window.
  31.    catch {shrinkWindow 2}
  32.    set win [car [winNames -f]]
  33.    setWinInfo -w $win dirty 0
  34.    setWinInfo -w $win read-only 1
  35. } 
  36.  
  37. #############################################################################
  38. #  List the name and value of each element of the array $arrName.
  39. #  (Convenient to use as a shell command.)
  40. #
  41. proc listArray {arrName} {
  42.     global $arrName
  43.     set lines {}
  44.     if {![catch {info vars $arrName}]} {
  45.         foreach nm [array names $arrName] {
  46.             set val [expr \$$arrName\($nm\)]
  47.             append lines "\r\"$nm\"\t\{$val\}"
  48.         }
  49.         insertText $lines
  50.     } else {
  51.         alertnote "\"$arrName\" doesn't exist in this context"
  52.     }
  53. }
  54.  
  55. #############################################################################
  56. #  Write out the active definition of the proc $procName.
  57. #  (Convenient to use as a shell command.)
  58. #
  59. proc listProc {procName} {
  60.     set lines {}
  61.     if {![catch {info procs "*$procName*"} procList]} {
  62.         foreach p $procList {
  63.             set pargs [info args $p]
  64.             set arglist {}
  65.             foreach a $pargs {
  66.                 if {[info default $p $a def]} {
  67.                     append arglist " {$a $def}" 
  68.                 } else {
  69.                     append arglist " $a"
  70.                 }
  71.             }
  72.             append lines "\rproc $p {[string trim $arglist]} {"
  73.             append lines [info body $p]
  74.             append lines "}\r"
  75.         }
  76.         insertText $lines
  77.     }
  78. }
  79.  
  80. #############################################################################
  81. # Adjust the dimensions of the current window to match the length (and 
  82. # optionally the width) of the text that it contains.  If shrinkWidth is 
  83. # omitted or set to zero, then only the height of the window is adjusted.
  84. # If it's set to 1, then the width is adjusted to accomodate the widest
  85. # line in the file; if it's set to 2, then the width is set based on only
  86. # the currently displayed lines (moves insertion onto the screen, as a 
  87. # side effect.)
  88.  
  89. proc shrinkWindow {{shrinkWidth 0}} {
  90.     global defHeight defWidth
  91.     # These constants work for 9-pt Monaco type
  92.     set lineht 11
  93.     set htoff 22
  94.     set chwd 6
  95.     set choff 20
  96.     
  97.     set wd [lindex [getGeometry] 2]
  98.     set ht [lindex [getGeometry] 3]
  99.     set top [lindex [getGeometry] 1]
  100.     set left [lindex [getGeometry] 0]
  101.     
  102.     set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
  103.     set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
  104.     set mnht 120
  105.     set mnwd 200
  106.  
  107.     set htWd [fileHtWd $shrinkWidth]
  108.     set lines [lindex $htWd 0]
  109.     set chars [lindex $htWd 1]
  110.  
  111.     if {$lines <= 1} then {set lines 10}
  112.     
  113.     
  114.     if {$lines > 0} {
  115.         set ht [expr $htoff + ( $lineht * (1 + $lines)) ]
  116.     } elseif {$ht > $defHeight} {
  117.         set ht $defHeight
  118.     }
  119.     
  120.     if {$chars > 0} {
  121.         set wd [expr $choff + ( $chwd * (2 + $chars)) ]
  122.     } elseif {$wd > $defWidth} {
  123.         set wd $defWidth
  124.     }
  125.     
  126.     if {$ht > $mxht} then {set ht $mxht}
  127.     if {$wd > $mxwd} then {set wd $mxwd}
  128.     if {$ht < $mnht} then {set ht $mnht}
  129.     if {$wd < $mnwd} then {set wd $mnwd}
  130.     sizeWin $wd $ht
  131. }
  132.  
  133. #############################################################################
  134. # Return the number of lines and the maximum number of characters in any 
  135. # line of a file.  It would be nice if there was a built-in command to
  136. # do this (i.e., compiled C code) because this is a pretty slow way to
  137. # get the maximum line width.
  138.  
  139. proc fileHtWd {{checkWidth 0}} {
  140.     set text [getText 0 [maxPos]] 
  141.     getWinInfo arr
  142.     set tabw [expr $arr(tabsize) - 1]
  143.     
  144.     set lines [split $text "\r"]
  145.     set nlines [llength $lines]
  146.  
  147.     if {$checkWidth > 1} {
  148.         set lines [eval lrange \$lines [displayedLines]]
  149.     }
  150.     
  151.     set llen 0
  152.     if {$checkWidth > 0} {
  153.         foreach line $lines {
  154.             regsub {                +∞.*$} $line {} line
  155.             regsub {    } $line {    } line
  156.             set len [string length $line]
  157.             if {[set ntab [llength [split $line "\t"]]] > 1} {
  158.                 set len [expr $len + $tabw*($ntab-1)]
  159.             }
  160.             if { $len > $llen} {
  161.                 set llen $len
  162.             }
  163.         }
  164.     }
  165. #    alertnote "Text Height : $nlines ; Text Width : $llen "
  166.     return [list $nlines $llen]
  167. }
  168.  
  169. # Report what range of lines are displayed in any window.
  170. # (A side effect is that the insertion point is moved to the 
  171. # top of the window, if it was previously off-screen)
  172. #
  173. proc displayedLines {{window {}}} {
  174.     if {$window == {}} { set window [car [winNames -f]] }
  175.  
  176.     bringToFront $window
  177.     set oldPos [getPos]
  178.     moveInsertionHere
  179.     set top [getPos]
  180.     set first [lindex [posToRowCol $top] 0]
  181.     moveInsertionHere -last
  182.     set bottom [getPos]
  183.     set last [lindex [posToRowCol $bottom] 0]
  184.  
  185.     if {$oldPos < $top || $oldPos > $bottom} {
  186.         goto $top
  187.     } else {
  188.         goto $oldPos
  189.     }
  190.  
  191.     return [list $first $last]
  192. }
  193.  
  194.  
  195.